home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Meeting Pearls 4
/
Meeting Pearls Vol. IV (1996)(GTI - Schatztruhe)[!].iso
/
Pearls
/
dev
/
Oberon
/
OberonV4
/
system
/
KeplerFrames.Mod
(
.txt
)
< prev
next >
Wrap
Oberon Text
|
1995-06-12
|
25KB
|
725 lines
Syntax10.Scn.Fnt
MODULE KeplerFrames; (* J. Templ, 18.06.92, for PowerMac *)
IMPORT
KeplerPorts, KeplerGraphs, TextFrames, Viewers, MenuViewers, Display, Oberon, Files, Input, Texts, Fonts, TextPrinter;
CONST
invFoc = 2; (* notify op-codes *)
xlen = 3 * 4;
eps = xlen + 4;
ML = 2; MM = 1; MR = 0;
cancel = {ML, MM, MR};
DEL = 7FX; BS = 08X;
fg = Display.white;
TYPE
FocusPoint* = POINTER TO FocusPointDesc;
FocusPointDesc* = RECORD
next*: FocusPoint;
p*: KeplerGraphs.Star;
END ;
Button* = POINTER TO ButtonDesc;
ButtonDesc* = RECORD
(KeplerGraphs.ConsDesc)
cmd*, par*: ARRAY 32 OF CHAR
END ;
Caption* = POINTER TO CaptionDesc;
CaptionDesc* = RECORD
(KeplerGraphs.ConsDesc)
s*: ARRAY 128 OF CHAR;
fnt*: Fonts.Font;
align*: SHORTINT (* 0 = left, 1 = centerX, 2 = right, 3 = centerXY *)
END ;
Frame* = POINTER TO FrameDesc;
FrameDesc* = RECORD (KeplerPorts.DisplayPortDesc);
G*: KeplerGraphs.Graph;
col*, grid*: INTEGER;
END ;
UpdateMsg* = RECORD
(Display.FrameMsg)
id*: INTEGER;
G*: KeplerGraphs.Graph;
O*: KeplerGraphs.Object;
P*: KeplerPorts.Port
END ;
SelMsg* = RECORD
(Display.FrameMsg)
time*: LONGINT;
G*: KeplerGraphs.Graph
END ;
Notifier* = PROCEDURE (op: INTEGER; G: KeplerGraphs.Graph; O: KeplerGraphs.Object; P: KeplerPorts.Port);
(*the graphics caret consists of a number of focus points and an optional focus caption *)
Focus*: KeplerGraphs.Graph;
first*, last*: FocusPoint;
nofpts*: INTEGER;
focus*: Caption;
carpos*: INTEGER;
upd: Frame;
PROCEDURE Min(x, y: INTEGER): INTEGER;
BEGIN IF x < y THEN RETURN x ELSE RETURN y END
END Min;
PROCEDURE Max(x, y: INTEGER): INTEGER;
BEGIN IF x > y THEN RETURN x ELSE RETURN y END
END Max;
PROCEDURE NotifyDisplay* (op: INTEGER; G: KeplerGraphs.Graph; O: KeplerGraphs.Object; P: KeplerPorts.Port);
VAR M: UpdateMsg;
BEGIN M.id := op; M.G := G; M.O := O; M.P := P; Viewers.Broadcast(M)
END NotifyDisplay;
PROCEDURE AppendFocusPoint*(p: KeplerGraphs.Star);
VAR fp: FocusPoint;
BEGIN NEW(fp); fp.p := p; fp.next := NIL;
IF last = NIL THEN first := fp ELSE last.next := fp END ;
last := fp; INC(nofpts);
NotifyDisplay(invFoc, Focus, p, NIL)
END AppendFocusPoint;
PROCEDURE DeleteFocusPoint*(F: Frame);
VAR p: FocusPoint;
BEGIN
IF last # NIL THEN
NotifyDisplay(invFoc, Focus, last.p, NIL);
IF nofpts = 1 THEN
first := NIL; last := NIL; nofpts := 0
ELSIF nofpts > 1 THEN p := first;
WHILE p^.next # last DO
p := p^.next
END ;
p.next := NIL; DEC(nofpts); last := p
END
END
END DeleteFocusPoint;
PROCEDURE IsFocusPoint*(p: KeplerGraphs.Star): BOOLEAN;
VAR fp: FocusPoint;
BEGIN fp := first;
WHILE (fp # NIL) & (fp.p # p) DO fp := fp.next END ;
RETURN fp # NIL
END IsFocusPoint;
PROCEDURE ThisButton*(G: KeplerGraphs.Graph; x, y: INTEGER): Button;
VAR b: Button; c: KeplerGraphs.Constellation; p0, p1: KeplerGraphs.Star;
BEGIN
c := G.cons; b := NIL;
WHILE c # NIL DO
IF c IS Button THEN p0 := c.p[0]; p1 := c.p[1];
IF ((x > p0.x) = (x < p1.x)) & ((y > p0.y) = (y < p1.y)) THEN b := c(Button) END
END ;
c := c.next
END ;
RETURN b
END ThisButton;
PROCEDURE MarkedButton*(): Button;
VAR V: Viewers.Viewer; F: Frame;
BEGIN
V := Oberon.MarkedViewer();
IF (V.dsc # NIL) & (V.dsc.next # NIL) & (V.dsc.next IS Frame) THEN
F := V.dsc.next(Frame);
RETURN ThisButton(F.G, F.Cx(Oberon.Pointer.X), F.Cy(Oberon.Pointer.Y))
ELSE RETURN NIL
END
END MarkedButton;
PROCEDURE ThisPoint(G: KeplerGraphs.Graph; x, y: INTEGER): KeplerGraphs.Star;
VAR fp: FocusPoint; p: KeplerGraphs.Star;
BEGIN fp := first;
WHILE (fp # NIL) & ((ABS(fp.p.x - x) > eps) OR (ABS(fp.p.y - y) > eps)) DO fp := fp.next END ;
IF (fp = NIL) OR (fp.p.refcnt = 0) OR (fp.p IS KeplerGraphs.Planet) OR (G # Focus) THEN
p := G.stars;
WHILE (p # NIL) & ((ABS(p.x - x) > eps) OR (ABS(p.y - y) > eps)) DO p := p.next END ;
ELSE p := fp.p
END ;
RETURN p
END ThisPoint;
PROCEDURE ThisCaption*(G: KeplerGraphs.Graph; x, y: INTEGER): Caption;
VAR s: Caption; c: KeplerGraphs.Constellation; p: KeplerPorts.BalloonPort;
BEGIN
IF ThisPoint(G, x, y) # NIL THEN RETURN NIL END ;
c := G.cons; s := NIL; NEW(p);
WHILE c # NIL DO
IF c IS Caption THEN
KeplerPorts.InitBalloon(p); c.Draw(p);
IF (x > p.X) & (x <= p.X + p.W) & (y > p.Y) & (y < p.Y + p.H) THEN s := c(Caption) END
END ;
c := c.next
END ;
RETURN s
END ThisCaption;
PROCEDURE GetPoint* (VAR p: KeplerGraphs.Star);
VAR fp: FocusPoint;
BEGIN
fp := first; p := fp.p; first := fp.next;
IF first = NIL THEN last := NIL END;
NotifyDisplay(invFoc, Focus, p, NIL);
DEC(nofpts)
END GetPoint;
PROCEDURE ConsumePoint* (VAR p: KeplerGraphs.Star);
BEGIN
GetPoint(p);
IF (p.refcnt = 0) & ~(p IS KeplerGraphs.Planet) THEN Focus.Append(p) END ;
INC(p.refcnt)
END ConsumePoint;
PROCEDURE SelectObjects(G: KeplerGraphs.Graph; x, y: INTEGER);
VAR
c: KeplerGraphs.Constellation;
B: KeplerPorts.BalloonPort;
i: INTEGER;
BEGIN
c := G.cons; NEW(B);
WHILE c # NIL DO
KeplerPorts.InitBalloon(B);
c.Draw(B);
IF (B.X <= x) & (B.X + B.W >= x) & (B.Y <= y) & (B.Y + B.H >= y) THEN
FOR i := 0 TO c.nofpts-1 DO
IF ~c.p[i].sel THEN G.FlipSelection(c.p[i]) END
END
END ;
c := c.next
END
END SelectObjects;
PROCEDURE SelectPoints(G: KeplerGraphs.Graph; x0, y0, x1, y1: INTEGER);
VAR p: KeplerGraphs.Star;
BEGIN p := G.stars;
IF (x0 = x1) & (y0 = y1) THEN
WHILE p # NIL DO
IF (p.x >= x0-12) & (p.x <= x0+12) & (p.y >= y0-12) & (p.y <= y0+12) THEN
G.FlipSelection(p);
RETURN
END ;
p := p.next
END ;
SelectObjects(G, x0, y0)
ELSE
WHILE p # NIL DO
IF ~p.sel THEN
IF (p.x >= x0) & (p.x <= x1) & (p.y >= y0) & (p.y <= y1) THEN
G.FlipSelection(p) (* direct selection *)
END
END ;
p := p.next
END
END
END SelectPoints;
PROCEDURE AlignToGrid*(F: Frame; VAR X, Y: INTEGER);
VAR dX, dY: INTEGER;
BEGIN
IF F.grid > 0 THEN
dX := X - F.CX(0) + F.grid DIV 2; dY := Y - F.CY(0) + F.grid DIV 2;
X := F.CX(0) + dX - dX MOD F.grid;
Y := F.CY(0) + dY - dY MOD F.grid
END
END AlignToGrid;
PROCEDURE GetMouse* (F: Frame; VAR x, y: INTEGER; VAR keys: SET);
VAR X, Y: INTEGER;
BEGIN
Input.Mouse(keys, X, Y);
AlignToGrid(F, X, Y);
x := F.Cx(X); y := F.Cy(Y)
END GetMouse;
PROCEDURE DrawGrid(F: Frame); (* aligned to (x0, y0) *)
CONST minGrid = 20;
VAR grid, i, j: INTEGER;
BEGIN
IF F.grid < minGrid THEN
grid := ((minGrid - 1) DIV F.grid + 1) * F.grid
ELSE grid := F.grid
END ;
i := F.X + F.x0 DIV F.scale MOD grid;
WHILE i < F.X + F.W DO
j := F.Y + (F.H + F.y0 DIV F.scale) MOD grid;
WHILE j < F.Y + F.H DO
Display.ReplConst(Display.white, i, j, 1, 1, Display.replace);
INC(j, grid)
END ;
INC(i, grid)
END
END DrawGrid;
(* ------------------------------------ Button methods ------------------------------------ *)
PROCEDURE (B: Button) Execute* (keys: SET);
VAR res: INTEGER;
par: Oberon.ParList;
W: Texts.Writer;
cmd: ARRAY 32 OF CHAR;
BEGIN
IF keys = {MM} THEN
NEW(par); par.vwr := Viewers.This(Display.Width-1, Display.Height-1);
par.frame := par.vwr.dsc.next; par.text := TextFrames.Text(""); par.pos := 0;
Texts.OpenWriter(W); Texts.WriteString(W, B.par); Texts.Append(par.text, W.buf);
COPY(B.cmd, cmd); Oberon.Call(cmd, par, FALSE, res)
ELSIF keys = {MM, MR} THEN
Texts.OpenWriter(W); Texts.WriteString(W, B.cmd); Texts.Write(W, " "); Texts.WriteString(W, B.par); Texts.WriteLn(W);
Texts.Append(Oberon.Log, W.buf)
END
END Execute;
PROCEDURE^ (F: Frame) TrackMouse* (x, y: INTEGER; keys: SET);
PROCEDURE (B: Button) HandleMouse*(F: Frame; x, y: INTEGER; keys: SET);
VAR keySum: SET; x0, y0, w, h: INTEGER;
BEGIN
IF MM IN keys THEN
keySum := keys;
x0 := Min(B.p[0].x, B.p[1].x); y0 := Min(B.p[0].y, B.p[1].y);
w := ABS(B.p[0].x - B.p[1].x); h := ABS(B.p[0].y - B.p[1].y);
F.DrawRect(x0-4, y0-4, w+8, h+8, 5, Display.invert);
REPEAT
F.TrackMouse(x, y, keys);
GetMouse(F, x, y, keys);
keySum := keySum + keys
UNTIL keys = {};
F.DrawRect(x0-4, y0-4, w+8, h+8, 5, Display.invert);
B.Execute(keySum)
END
END HandleMouse;
PROCEDURE (B: Button) Write* (VAR R: Files.Rider);
BEGIN Files.WriteString(R, B.cmd); Files.WriteString(R, B.par); B.Write^(R)
END Write;
PROCEDURE (B: Button) Read* (VAR R: Files.Rider);
BEGIN Files.ReadString(R, B.cmd); Files.ReadString(R, B.par); B.Read^(R)
END Read;
(* ------------------------------- Caption ------------------------------- *)
PROCEDURE FlipCaret(p: KeplerPorts.Port; x, y, h: INTEGER);
BEGIN p.FillRect(x, y - 4, 4, h + 8, Display.white, 5, Display.invert)
END FlipCaret;
PROCEDURE CarPos(VAR s: ARRAY OF CHAR; fnt: Fonts.Font; carpos: INTEGER) : INTEGER;
VAR fno: SHORTINT; ch: CHAR; dx, w, i, sdx, sx, sy, sw, sh: INTEGER; p: LONGINT;
BEGIN
fno := TextPrinter.FontNo(fnt);
w := 0; i := 0; ch := s[0];
WHILE i < carpos DO
dx := SHORT(TextPrinter.DX(fno, ch) DIV 3048);
INC(w, dx); INC(i); ch := s[i]
END ;
RETURN w
END CarPos;
PROCEDURE (C: Caption) Draw*(F: KeplerPorts.Port);
VAR x, y, w: INTEGER; p: KeplerPorts.BalloonPort;
BEGIN
x := C.p[0].x; y := C.p[0].y;
IF C.align # 0 THEN
w := KeplerPorts.StringWidth(C.s, C.fnt);
IF C.align = 1 THEN DEC(x, w DIV 2)
ELSIF C.align = 2 THEN DEC(x, w)
ELSIF C.align = 3 THEN DEC(x, w DIV 2); DEC(y, (C.fnt.height DIV 2 + C.fnt.minY) * 4)
ELSE DEC(y, C.fnt.maxY * 4);
IF C.align = 5 THEN DEC(x, w DIV 2)
ELSIF C.align = 6 THEN DEC(x, w)
END
END
END ;
F.DrawString(x, y, C.s, C.fnt, Display.white, Display.paint);
IF (F IS Frame) & (focus = C) THEN
w := CarPos(C.s, C.fnt, carpos); NEW(p); KeplerPorts.InitBalloon(p); C.Draw(p);
FlipCaret(F, p.X + w, p.Y, p.H)
END
END Draw;
PROCEDURE (C: Caption) Write* (VAR R: Files.Rider);
BEGIN (*upward compatible encoding of C.align*)
IF C.align # 0 THEN Files.Write(R, C.align) END ;
Files.WriteString(R, C.s);
Files.WriteString(R, C.fnt.name);
C.Write^(R)
END Write;
PROCEDURE (C: Caption) Read* (VAR R: Files.Rider);
VAR fntname: ARRAY 32 OF CHAR;
BEGIN (*upward compatible encoding of C.align*)
Files.Read(R, C.align);
IF (C.align = 0) OR (C.align > 3) THEN C.align := 0; Files.Set(R, Files.Base(R), Files.Pos(R) - 1) END ;
Files.ReadString(R, C.s);
Files.ReadString(R, fntname);
C.fnt := Fonts.This(fntname); C.Read^(R)
END Read;
(* ------------------------------------ Frame methods ------------------------------------ *)
PROCEDURE (F: Frame) TrackMouse* (x, y: INTEGER; keys: SET);
BEGIN
Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, Max(F.CX(x), 0), Min(F.CY(y), Display.Height));
END TrackMouse;
PROCEDURE (F: Frame) Reduce* (newY: INTEGER);
BEGIN
F.H := F.H + F.Y - newY; F.Y := newY;
END Reduce;
PROCEDURE (F: Frame) Invert* (p: KeplerGraphs.Star);
BEGIN
IF (p IS KeplerGraphs.Planet) OR (p.refcnt > 0) THEN (* + *)
F.DrawLine(p.x - xlen - 4, p.y, p.x + xlen + 4, p.y, Display.white, Display.invert);
F.DrawLine(p.x, p.y + xlen + 4, p.x, p.y - xlen - 4, Display.white, Display.invert)
ELSE (* x *)
F.DrawLine(p.x - xlen, p.y - xlen, p.x + xlen, p.y + xlen, Display.white, Display.invert);
F.DrawLine(p.x - xlen, p.y + xlen, p.x + xlen, p.y - xlen, Display.white, Display.invert)
END
END Invert;
PROCEDURE Intersect(F: Frame; VAR X, Y, W, H: INTEGER): BOOLEAN;
VAR t: INTEGER;
BEGIN
t := X+W;
IF F.X > X THEN X := F.X END;
IF F.X+F.W < t THEN W := F.X+F.W-X ELSE W := t-X END;
IF W <= 0 THEN RETURN FALSE END;
t := Y+H;
IF F.Y > Y THEN Y := F.Y END;
IF F.Y+F.H < t THEN H := F.Y+F.H-Y ELSE H := t-Y END;
RETURN H > 0
END Intersect;
PROCEDURE InvFocus(F: Frame);
VAR fp: FocusPoint;
BEGIN
IF Focus = F.G THEN
fp := first;
WHILE fp # NIL DO F.Invert(fp.p); fp := fp.next END
END
END InvFocus;
PROCEDURE (F: Frame) Extend*(newY: INTEGER);
VAR dY, newH: INTEGER;
BEGIN dY := F.Y - newY;
Display.ReplConst(F.col, F.X, newY, F.W, F.Y - newY, Display.replace);
F.H := F.H + F.Y - newY; F.Y := newY; newH := F.H;
INC(F.y0, (newH - dY) * F.scale); F.H := dY;
IF F.grid > 0 THEN DrawGrid(F) END;
F.G.Draw(F);
InvFocus(F);
F.H := newH; DEC(F.y0, (newH - dY) * F.scale)
END Extend;
PROCEDURE (F: Frame) Restore*(X, Y, W, H: INTEGER);
BEGIN
IF (W > 0) & (H > 0) THEN
upd.col := F.col; upd.G := F.G; upd.grid := F.grid; upd.scale := F.scale;
upd.X := X; upd.Y := Y; upd.W := W; upd.H := H;
IF Intersect(F, upd.X, upd.Y, upd.W, upd.H) THEN
H := upd.H;
upd.x0 := F.x0 + (F.X - upd.X) * F.scale;
upd.y0 := F.y0 + (F.Y + F.H - upd.Y - upd.H) * F.scale;
Oberon.RemoveMarks(upd.X, upd.Y, upd.W, upd.H);
upd.Reduce(upd.Y + upd.H); upd.Extend(upd.Y - H)
END
END
END Restore;
PROCEDURE MoveOrigin*(F: Frame; x0, y0: INTEGER);
VAR X, Y, W, H, dX, dY: INTEGER;
BEGIN
dX := (x0 - F.x0) DIV F.scale; dY := (y0 - F.y0) DIV F.scale;
IF (dX # 0) OR (dY # 0) THEN
F.x0 := x0; F.y0 := y0;
Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
X := F.X + dX; Y := F.Y + dY; W := F.W; H := F.H;
IF Intersect(F, X, Y, W, H) THEN Display.CopyBlock(X-dX, Y-dY, W, H, X, Y, Display.replace) END ;
IF dY > 0 THEN F.Restore(F.X, F.Y, F.W, dY); Y := F.Y + dY
ELSIF dY < 0 THEN F.Restore(F.X, F.Y + F.H + dY, F.W, -dY); Y := F.Y
END;
IF dX > 0 THEN F.Restore(F.X, Y, dX, F.H - ABS(dY))
ELSIF dX < 0 THEN F.Restore(F.X + F.W + dX, Y, -dX, F.H - ABS(dY))
END
END
END MoveOrigin;
PROCEDURE Move(F: Frame; x1, y1: INTEGER);
VAR keySum, keys: SET; x0, y0, x10, y10, x2, y2: INTEGER;
dragSel, dragOrg: BOOLEAN;
BEGIN
x0 := F.x0; y0 := F.y0; x10 := x1; y10 := y1; keySum := {MM};
dragSel := FALSE; dragOrg := FALSE;
REPEAT
GetMouse(F, x2, y2, keys);
F.TrackMouse(x2, y2, keys);
keySum := keySum + keys;
IF keySum = cancel THEN
IF dragSel THEN F.G.MoveSelection(x10 - x1, y10 - y1); dragSel := FALSE
ELSIF dragOrg THEN MoveOrigin(F, x0, y0); dragOrg := FALSE
END
ELSIF keySum = {MM, ML} THEN
IF (x1 # x2) OR (y1 # y2) THEN F.G.MoveSelection(x2 - x1, y2 - y1); x1 := x2; y1 := y2; dragSel := TRUE END ;
ELSIF keySum = {MM, MR} THEN dragOrg := TRUE;
MoveOrigin(F, F.x0 + x2 - x1, F.y0 + y2 - y1)
END
UNTIL keys = {};
IF keySum = {MM} THEN F.G.MoveSelection(x2 - x1, y2 - y1) END
END Move;
PROCEDURE DrawFrame(F: Frame; x1, y1, x2, y2: INTEGER);
VAR t: INTEGER;
BEGIN
IF x1 > x2 THEN t := x1; x1 := x2; x2 := t END;
IF y1 > y2 THEN t := y1; y1 := y2; y2 := t END;
t := F.scale;
F.FillRect(x1, y1, x2-x1, t, fg, 5, Display.invert);
F.FillRect(x1, y2, x2-x1, t, fg, 5, Display.invert);
F.FillRect(x1, y1, t, y2-y1, fg, 5, Display.invert);
F.FillRect(x2, y1, t, y2-y1, fg, 5, Display.invert)
END DrawFrame;
PROCEDURE Select(F: Frame; x, y: INTEGER);
VAR x1, y1, x2, y2: INTEGER; keySum, keys: SET; p0, p1: KeplerGraphs.Star;
BEGIN keySum := {MR};
x1 := x; y1 := y; keys := {};
DrawFrame(F, x, y, x1, y1); (* for symmetry only *)
LOOP
F.TrackMouse(x1, y1, keys);
GetMouse(F, x2, y2, keys);
keySum := keySum + keys;
IF keys = {} THEN EXIT END;
IF x2 # x1 THEN DrawFrame(F, x1, y, x2, y1); x1 := x2 END;
IF y2 # y1 THEN DrawFrame(F, x, y1, x1, y2); y1 := y2 END
END;
DrawFrame(F, x, y, x1, y1);
IF keySum # cancel THEN
SelectPoints(F.G, Min(x, x1), Min(y, y1), Max(x, x1), Max(y, y1));
IF keySum = {ML, MR} THEN F.G.DeleteSelection(2)
ELSIF (keySum = {MM, MR}) & (nofpts >= 2) THEN
GetPoint(p0); GetPoint(p1); Focus.CopySelection(F.G, p1.x - p0.x, p1.y - p0.y)
END
END
END Select;
PROCEDURE GetSelection*(VAR sel: KeplerGraphs.Graph);
VAR M: SelMsg;
BEGIN
M.time := -1; M.G := NIL;
Viewers.Broadcast(M);
sel := M.G
END GetSelection;
PROCEDURE Defocus;
VAR p: KeplerPorts.BalloonPort;
BEGIN
IF focus # NIL THEN
NEW(p); KeplerPorts.InitBalloon(p); focus.Draw(p);
focus := NIL;
Focus.notify(KeplerGraphs.restore, Focus, NIL, p);
END
END Defocus;
PROCEDURE DeFocus;
VAR s: KeplerGraphs.Star;
BEGIN WHILE nofpts > 0 DO GetPoint(s) END ;
END DeFocus;
PROCEDURE PassFocus(G: KeplerGraphs.Graph);
BEGIN Defocus; DeFocus; Focus := G
END PassFocus;
PROCEDURE Modify (F: Display.Frame; id, dY, Y, H: INTEGER);
BEGIN
WITH F: Frame DO
Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
IF id = MenuViewers.extend THEN
IF dY > 0 THEN
Display.CopyBlock(F.X, F.Y, F.W, F.H, F.X, F.Y + dY, Display.replace); INC(F.Y, dY)
END;
F.Extend(Y)
ELSIF id = MenuViewers.reduce THEN
F.Reduce(Y + dY);
IF dY > 0 THEN Display.CopyBlock(F.X, F.Y, F.W, F.H, F.X, Y, Display.replace); F.Y := Y END
END
END
END Modify;
PROCEDURE Drag(F: Frame; p: KeplerGraphs.Star);
VAR keySum, keys: SET; x, y, x0, y0: INTEGER;
BEGIN
PassFocus(Focus);
x0 := p.x; y0 := p.y; keys := {ML, MR}; keySum := {};
WHILE keys # {} DO
GetMouse(F, x, y, keys);
F.TrackMouse(x, y, keys);
keySum := keySum + keys;
IF (x # p.x) OR (y # p.y) THEN Focus.Move(p, x-p.x, y-p.y) END ;
END ;
IF keySum = cancel THEN Focus.Move(p, x0-p.x, y0-p.y) END
END Drag;
PROCEDURE Point(F: Frame; x, y: INTEGER; keys: SET);
VAR keySum: SET; p: KeplerGraphs.Star; new: BOOLEAN; sel: KeplerGraphs.Graph; b: Button;
BEGIN
keySum := keys;
p := ThisPoint(F.G, x, y);
IF p = NIL THEN new := TRUE; NEW(p); p.x := x; p.y := y; p.refcnt := 0 ELSE new := FALSE END ;
F.Invert(p);
WHILE keys # {} DO
F.TrackMouse(x, y, keys);
GetMouse(F, x, y, keys);
keySum := keySum + keys;
IF new & (keySum # {ML, MR}) & ((x # p.x) OR (y # p.y)) THEN F.Invert(p); p.x := x; p.y := y; F.Invert(p)
ELSIF (keySum = {ML, MR}) & ~(p IS KeplerGraphs.Planet) THEN (*experimental *)
F.Invert(p);
IF Focus # F.G THEN PassFocus(F.G) END ;
IF new THEN p.x := x; p.y := y; AppendFocusPoint(p);
b := MarkedButton();
IF b # NIL THEN b.Execute({MM});
Oberon.DrawCursor(Oberon.Pointer, Oberon.Star, Oberon.Pointer.X, Oberon.Pointer.Y)
END
END ;
Drag(F, p);
RETURN
END
END ;
F.Invert(p);
IF keySum = {ML, MM} THEN
IF nofpts >= 1 THEN GetSelection(sel);
F.G.CopySelection(sel, x - first.p.x, y - first.p.y)
END
ELSIF keySum # cancel THEN
IF Focus # F.G THEN PassFocus(F.G) END ;
IF new THEN p.x := x; p.y := y;
AppendFocusPoint(p);
ELSIF IsFocusPoint(p) & ~(p IS KeplerGraphs.Planet) THEN
PassFocus(Focus);
Focus.Move(p, x - p.x, y - p.y);
AppendFocusPoint(p)
ELSE AppendFocusPoint(p)
END
END
END Point;
PROCEDURE SetCaret (F: Frame; c: Caption; x: INTEGER);
VAR y, i, dx, w, oldw: INTEGER; keys: SET; ch: CHAR; fno: SHORTINT; p: KeplerPorts.BalloonPort;
BEGIN
NEW(p); KeplerPorts.InitBalloon(p); c.Draw(p); oldw := -1;
REPEAT
i := 0; w := 0; ch := c.s[i]; fno := TextPrinter.FontNo(c.fnt);
dx := SHORT(TextPrinter.DX(fno, ch) DIV 3048);
WHILE (ch # 0X) & (p.X + w + (dx DIV 2) < x) DO
INC(w, dx); INC(i); ch := c.s[i];
dx := SHORT(TextPrinter.DX(fno, ch) DIV 3048)
END ;
IF w # oldw THEN
IF oldw # -1 THEN FlipCaret(F, p.X + oldw, p.Y, p.H) END ;
FlipCaret(F, p.X + w, p.Y, p.H)
END ;
Input.Mouse(keys, x, y); x := F.Cx(x); y := F.Cy(y); F.TrackMouse(x, y, keys); oldw := w
UNTIL keys = {};
IF Focus # F.G THEN PassFocus(F.G) END ;
focus := c; carpos := i;
END SetCaret;
PROCEDURE (F: Frame) EditFrame* (x, y: INTEGER; keys: SET);
VAR b: Button; c: Caption;
BEGIN
GetMouse(F, x, y, keys);
IF keys = {MM} THEN b := ThisButton(F.G, x, y);
IF b # NIL THEN b.HandleMouse(F, x, y, keys)
ELSE Move(F, x, y)
END
ELSIF keys = {ML} THEN
IF (focus = NIL) & (first = NIL) OR (Focus # F.G) THEN Oberon.PassFocus(Viewers.This(F.X, F.Y)); PassFocus(F.G) END;
c := ThisCaption(F.G, x, y);
Defocus;
IF c # NIL THEN SetCaret(F, c, x)
ELSE Point(F, x, y, keys)
END
ELSIF keys = {MR} THEN Select(F, x, y)
END
END EditFrame;
PROCEDURE NewCaption(s: ARRAY OF CHAR; fnt: Fonts.Font; align, carp: INTEGER);
VAR o: Caption;
BEGIN
IF nofpts > 0 THEN Defocus;
NEW(o); o.nofpts := 1; o.align := SHORT(align); COPY(s, o.s); o.fnt := fnt;
focus := o; carpos := carp;
ConsumePoint(o.p[0]); Focus.Append(o);
END
END NewCaption;
PROCEDURE (F: Frame) Consume* (ch: CHAR);
VAR i: INTEGER; p: KeplerPorts.BalloonPort; o: Caption; s: ARRAY 2 OF CHAR;
BEGIN
IF focus # NIL THEN
NEW(p); KeplerPorts.InitBalloon(p); focus.Draw(p); (*old size*)
LOOP
IF (ch = DEL) OR (ch = BS) THEN
IF carpos > 0 THEN i := carpos;
REPEAT focus.s[i-1] := focus.s[i]; INC(i) UNTIL focus.s[i-1] = 0X;
DEC(carpos)
END
ELSIF (ch = 09X) OR (ch = 0DX) OR (ch = 0AX) THEN NewCaption("", focus.fnt, focus.align, 0);
RETURN
ELSIF ch # DEL THEN i := carpos;
WHILE focus.s[i] # 0X DO INC(i) END ;
IF i+1 < LEN(focus.s) THEN
REPEAT focus.s[i+1] := focus.s[i]; DEC(i) UNTIL i+1 = carpos;
focus.s[i+1] := ch; INC(carpos)
END
END ;
IF (ch >= " ") & (Input.Available() > 0) THEN Input.Read(ch) ELSE EXIT END
END ;
focus.Draw(p); (*plus new size*)
F.G.notify(KeplerGraphs.restore, F.G, NIL, p);
ELSE
IF ch = DEL THEN F.G.DeleteSelection(1)
ELSIF ch = BS THEN DeleteFocusPoint(F)
ELSIF ch = 0C1X THEN F.G.MoveSelection(0, F.scale)
ELSIF ch = 0C2X THEN F.G.MoveSelection(0, -F.scale)
ELSIF ch = 0C3X THEN F.G.MoveSelection(F.scale, 0)
ELSIF ch = 0C4X THEN F.G.MoveSelection(-F.scale, 0)
ELSIF ORD(ch) = 145 THEN F.Restore(F.X, F.Y, F.W, F.H)
ELSE s[0] := ch; s[1] := 0X; NewCaption(s, Oberon.CurFnt, 0, 1)
END ;
WHILE Input.Available() > 0 DO Input.Read(ch) END
END
END Consume;
PROCEDURE (F: Frame) Neutralize*;
BEGIN F.G.All(0); Defocus; DeFocus
END Neutralize;
PROCEDURE CopyOver(T: Texts.Text; beg, end: LONGINT);
VAR R: Texts.Reader; s, t: ARRAY 128 OF CHAR; fnt: Fonts.Font; ch: CHAR; i, j: INTEGER;
p: KeplerPorts.BalloonPort;
BEGIN
Texts.OpenReader(R, T, beg); Texts.Read(R, ch); fnt := R.fnt; i := 0;
WHILE (i < LEN(t)-1) & (Texts.Pos(R) <= end) & (ch # 0DX) DO s[i] := ch; INC(i); Texts.Read(R, ch) END ;
s[i] := 0X;
IF focus = NIL THEN NewCaption(s, fnt, 0, i)
ELSE COPY(focus.s, t); i := 0; j := carpos;
WHILE s[i] # 0X DO focus.s[j] := s[i]; INC(i); INC(j) END ;
i := carpos-1; carpos := j;
REPEAT INC(i); focus.s[j] := t[i]; INC(j) UNTIL t[i] = 0X;
NEW(p); KeplerPorts.InitBalloon(p); focus.Draw(p);
Focus.notify(KeplerGraphs.restore, Focus, NIL, p)
END
END CopyOver;
PROCEDURE TextSelection(G: KeplerGraphs.Graph): Texts.Text;
VAR W: Texts.Writer; T: Texts.Text; c: KeplerGraphs.Constellation; i: INTEGER;
BEGIN
T := TextFrames.Text(""); c := G.cons; Texts.OpenWriter(W);
WHILE c # NIL DO
WITH c: Caption DO
IF c.State() = 2 THEN Texts.SetFont(W, c.fnt); i := 0;
WHILE c.s[i] # 0X DO Texts.Write(W, c.s[i]); INC(i) END ;
Texts.WriteLn(W)
END
ELSE
END ;
c := c.next
END ;
Texts.Append(T, W.buf);
RETURN T
END TextSelection;
PROCEDURE Handle* (F: Display.Frame; VAR M: Display.FrameMsg);
VAR F1: Frame;
BEGIN
WITH F: Frame DO
WITH M: Oberon.InputMsg DO
IF (M.id = Oberon.track) & (M.keys # {}) THEN F.EditFrame(M.X-F.X-F.x0, M.Y-F.Y-F.H-F.y0, M.keys)
ELSIF M.id = Oberon.track THEN F.TrackMouse(F.Cx(M.X), F.Cy(M.Y), M.keys)
ELSIF M.id = Oberon.consume THEN F.Consume(M.ch)
END
| M: Oberon.ControlMsg DO
IF M.id = Oberon.neutralize THEN F.Neutralize
ELSIF M.id = Oberon.defocus THEN Defocus; DeFocus
END
| M: MenuViewers.ModifyMsg DO
Modify(F, M.id, M.dY, M.Y, M.H)
| M: UpdateMsg DO
IF M.G = F.G THEN
IF M.id = KeplerGraphs.draw THEN
Oberon.RemoveMarks(F.X, F.Y, F.W, F.H); InvFocus(F); M.O.Draw(F); InvFocus(F);
(* IF M.O IS KeplerGraphs.Star THEN (*invert*) M.O.Draw(F)
ELSE ClipFrames.InitBalloon(B); M.O.Draw(B);
F.Restore(F.CX(B.X) - 1, F.CY(B.Y) - 1, B.W DIV F.scale + 3, B.H DIV F.scale + 3)
END *)
ELSIF M.id = KeplerGraphs.restore THEN
F.Restore(F.CX(M.P.X) - 1, F.CY(M.P.Y) - 1, M.P.W DIV F.scale + 3, M.P.H DIV F.scale + 3);
ELSIF (M.id = invFoc) & (Focus = F.G) THEN F.Invert(M.O(KeplerGraphs.Star))
END
END
| M: SelMsg DO
IF F.G.seltime > M.time THEN
M.G := F.G; M.time := F.G.seltime
END
| M: Oberon.SelectionMsg DO
IF F.G.seltime > M.time THEN M.text := TextSelection(F.G);
M.time := F.G.seltime; M.beg := 0; M.end := M.text.len
END
| M: Oberon.CopyMsg DO
NEW(F1); M.F := F1; F1^ := F^
| M: Oberon.CopyOverMsg DO CopyOver(M.text, M.beg, M.end)
ELSE
END
END
END Handle;
PROCEDURE Open*(F: Frame; G: KeplerGraphs.Graph; grid, scale: INTEGER; notify: KeplerGraphs.Notifier; handle: Display.Handler);
BEGIN
F.G := G; F.grid := grid; F.scale := scale; G.notify := notify; F.handle := handle
END Open;
PROCEDURE New*(G: KeplerGraphs.Graph): Frame;
VAR F: Frame;
BEGIN NEW(F); Open(F, G, 0, 4, NotifyDisplay, Handle); RETURN F
END New;
BEGIN NEW(upd); NEW(Focus)
END KeplerFrames.